COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.begin ENDECR
C00004 00003
C00006 00004
C00007 00005
C00008 ENDMK
C⊗;
.begin ENDECR

Repeat 0,[
	The following code consists of 3 basic routines:

CRASZ.	Generate seed from ASCIZ password
	accepts in  7:	address of ASCIZ string or byte pointer
	returns    +1:	always, with seed in 5.

CRSIX.	Generate seed from SIXBIT password
	accepts in  5:	SIXBIT password string
	returns    +1:	always, with seed in 5.

CRYPT.	Encrypt a block of data
	accepts in  5:	seed generated by CRASZ. or CRSIX.
		    6:	block key or block number
		    7:	AOBJN pointer to block to be encrypted
	returns    +1:	always
]

; AC definitions

z==0
t1==1
t2==2
t3==3
t4==4
c==5
b==6
a==7
p==17

; JCALL is a macro to call a routine, saving and restoring AC's.

define JCALL routin
 movem 4,acsave+4
 movei 4,acsave
 blt 4,acsave+3
 pushj p,routin
 movsi 4,acsave
 blt 4,4
 popj p,
termin

; CRASZ. converts ASCIZ strings pointed to by A into seeds

.U"CRASZ.==pushj p,.
	jcall crasz
crasz:	tlnn a,-1		; see if byte pointer
	 hrli a,440700
	movei b,
	push p,b
crasz1:	movei c,
	move t1,[440600,,c]
crasz2:	ildb z,a
	jumpe z,crasz3
	caig z,"z		; lower case z
	 caig z,<" >
	  jrst crasz2
	caile z,"←
	 trz z,<" >
	subi z,<" >
	idpb z,t1
	tlne t1,770000
	 jrst crasz2
	xor c,(p)
	pushj p,crsix
	movem c,(p)
	jrst crasz1

crasz3:	jumpe c,crasz4
	xor c,(p)
	pushj p,crsix
	movem c,(p)
crasz4:	pop p,c
	jumpn c,crasz5
	skipe b
	 move c,[13702,,175435]
crasz5:	popj p,

; CRSIX. - handles SIXBIT atoms (called from CRASZ)

.U"CRSIX.==pushj p,.
	jcall crsix
crsix:	jumpe c,crsix1
	pushj p,cwran
	hlr b,b
	sub p,b
crsix1:	popj p,

; CRYPT. - basic block en/de crypter

.U"CRYPT.==pushj p,.
	jcall crypt
crypt:	jumpe c,crypt4
	move z,b
	imuli z,200401
	and z,[11111111]
	mul z,[11111111]
	tlz t1,600000
	add c,t1
	pushj p,cwran
	hlrz t1,b
	movn t1,t1
	hrl t1,t1
	addi t1,1(p)
	push p,t1
crypta:	move t1,(p)
	hrrz t2,b
	hrl t2,t2
	add t2,t1
crypt1:	move z,(t2)
	addb z,(t1)
	xorm z,(a)
	aobjp a,crypt3
	aobjn t2,crypt2
	hrrz t2,(p)
	tlo t2,400000
crypt2:	aobjn t1,crypt1
	jrst crypta

crypt3:	hlr b,b
	aobjn b,.+1
	sub p,b
crypt4:	popj p,

cwran:	ldb t4,[370300,,c]
	pop p,t2
cwran0:	xor c,[13702,,175435]
	tlz c,760000
	jumpe c,cwran0
	hlrz t3,majik(t4)
cwran1:	movei z,6
cwran2:	move b,c
	rot b,13
	xor b,c
	rot b,-6
	lshc c,6
	sojg z,cwran2
	push p,c
	sojg t3,cwran1
	move b,majik(t4)
	jrst (t2)

majik:	7,,4
	11,,5
	12,,7
	13,,11
	17,,10
	17,,13
	21,,5
	22,,13

acsave:	block 5

.end ENDECR		; *** The End ***
β